~ THIS IS A FUNCTION, USED WHEN ERRORS ARE DETECTED, TO SWAP OUT MLISP
~ AND SWAP IN A TEXT EDITOR (SOS).  OTHER INSTALLATIONS MAY WISH TO DELETE
~ THIS FUNCTION AND REPLACE IT WITH SOMETHING ELSE.


(LAP SWAP SUBR) 		~ (SWAP @(FILE.EXT) PAGE# LINE#)
	(PUSH P 1)		~ FNAME.EXT
	(275000 2 577777)	~ SUBI 2,INUM0
	(PUSH P 2)		~ PAGE NUMBER
	(MOVE 1 3) 
	(PUSHJ P LINUM:) 
	(PUSH P 1)		~ LINE NUMBER
	(MOVE 1 -2 P) 
	(CALL 1 (E ATOM)) 
	(JUMPE 1 DOTTED:) 
	(MOVE 1 -2 P) 
	(MOVEI 2 (QUOTE / / / / / / ))
	(CALL 2 (E CONS))
	(MOVEM 1 -2 P)
DOTTED:	(HLRZ@ 1 -2 P) 
	(MOVEI 2 (QUOTE PNAME))
	(CALL 2 (E GET))
	(PUSHJ P MAKSIX:) 
	(PUSH P 1) 
	(HRRZ@ 1 -3 P) 
	(MOVEI 2 (QUOTE PNAME))
	(CALL 2 (E GET))
	(PUSHJ P MAKSIX:) 
	(POP P 13) 
	(POP P 15) 
	(POP P 16) 
	(MOVE 14 13) 
	(MOVE 13 1) 
	(MOVEI 11 NIL) 
	(047000 11 24) 		~ CALLI 11,24  -  GETPPN UUO 
	(MOVE 1 (C 0 0 RUN:)) 
	(047000 1 400004) 	~ CALLI 1,400004  -  SWAP UUO  

RUN:	(446353 000000)		~ 'DSK   '
	(635763 000000)		~ 'SOS   '
	(445560 000000)		~ 'DMP   '
	(0 0 1)			~ JOBSA + 1
	(000021 0 000023)	~ '  1  3'
 
MAKSIX:	(PUSH P 1) 		~ CONVERT ASCII TO SIXBIT
	(MOVEI 5 5) 
	(MOVE 2 (C 440600 0 1 0)) 
	(MOVEI 1 NIL) 
MAKSIX1:(HLRZ@ 4 0 P) 
	(505000 4 440700)	~ HRLI 4,440700
INLUP:	(134000 3 4) 		~ ILDB 3,4
	(JUMPE 3 DONE:) 
	(275000 3 40)		~ SUBI 3,40
	(136000 3 2)		~ IDPB 3,2
	(367000 5 INLUP:)	~ SOJG 5,INLUP
	(MOVEI 5 1) 
	(HRRZ@ 4 0 P) 
	(MOVEM 4 0 P) 
	(JUMPN 4 MAKSIX1:) 
DONE:	(SUB P (C 0 0 1 1)) 
	(POPJ P) 
 
LINUM:	(MOVE 4 (C 010700 0 3))	~ MAKE A LINE NUMBER FOR SOS
	(275000 1 577777)	~ SUBI 1,INUM0
LINUM1:	(231000 1 10.)		~ IDIVI 1,=10
	(271000 2 60) 		~ ADDI 2,60
	(137000 2 4)		~ DPB 2,4
	(270000 4 (C 070000 0))	~ ADD 4,[XWD 070000,0]
	(607000 4 400000)	~ TLNN 4,400000
	(JRST 0 LINUM1:) 
	(MOVE 1 3) 
	(660000 1 1)		~ TRO 1,1
	(POPJ P) 
	NIL 
(SETQ &IDTYPE    0)
(SETQ &STRTYPE   1)
(SETQ &NUMTYPE   2)
(SETQ &DELIMTYPE 3)
(SETQ &X& (SETQ &Y& NIL))


(MAPCAR (FUNCTION
	 (LAMBDA (&X)
	  (PROG2 (PUTPROP (CAR &X) &IDTYPE (QUOTE &TRANSTYPE))
		 (PUTPROP (CAR &X) (CADR &X) (QUOTE &TRANS)))))
	(QUOTE ((/* TIMES) (// QUOTIENT) (/+ PLUS) (/- DIFFERENCE)
		(/↑ PRELIST) (/↓ SUFLIST) (/@ APPEND)
		(/= EQUAL) (/≠ NEQUAL) (/≤ LEQUAL) (/≥ GEQUAL) (/ε MEMBER)
		(/& AND) (/∧ AND) (/| OR) (/∨ OR) (/¬ NOT))))


(MAPCAR (FUNCTION
	 (LAMBDA (&X)
	  (PROG NIL
		(MAPCAR (FUNCTION
			 (LAMBDA (&Y)
			  (PROG NIL
				(AND (EQ (CAR &X) (QUOTE &PREFIX))
				     (PUTPROP &Y 1000. (QUOTE &RIGHT))
				     (PUTPROP &Y -1 (QUOTE &LEFT)))
				(AND (EQ (CAR &X) (QUOTE &RESWORD))
				     (PUTPROP &Y -1. (QUOTE &LEFT)))
				(AND (EQ (CAR &X) (QUOTE &DELIM))
				     (PUTPROP &Y -1. (QUOTE &LEFT)))
				(PUTPROP &Y T (CAR &X)))))
			(CDR &X)))))
	(QUOTE ((&RESWORD BEGIN END NEW SPECIAL IF THEN ELSE ALSO
		  FOR IN ON TO BY DO COLLECT UNTIL WHILE
		  EXPR FEXPR LEXPR MACRO LAMBDA DEFINE COMMENT INLINE OCTAL)
		(&DELIM /( /) /< /> /[ /] /; /, /. /' /⊗)
                (&FNTYPE EXPR FEXPR LEXPR MACRO)
		(&ASSOC TIMES PLUS AND OR)
		(&SPECIAL QT LPAR RPAR LABR RABR LSBR RSBR DASH STAR PLUSS SLASH
		  BLANK COLON COMMA PERIOD DOLLAR EQSIGN LARROW DBQUOTE PERCENT
		  CIRCLEX UNDERBAR SEMICOLON TAB LF VT FF CR ALTMODE TRUE FALSE F)
		(&PREFIX STR STRP STRLEN AT PRINTSTR DIFFERENCE
		  CAR CDR
		  CAAR CADR CDAR CDDR
		  CAAAR CAADR CADAR CDAAR CADDR CDADR CDDAR CDDDR
		  CAAAAR CAAADR CAADAR CADAAR CDAAAR CAADDR CADADR CDAADR
		  CADDAR CDADAR CDDAAR CADDDR CDADDR CDDADR CDDDAR CDDDDR
		  ABS ADD1 ARG ASCII ATOM BAKGAG CSYM DDTIN DDTOUT ED ERR EVAL *EVAL
		  EXAMINE EXPLODE EXPLODEC FIX FLATSIZE FUNCTION *FUNCTION GCGAG
		  *GETSYM GO INITFN INTERN LAST LENGTH LINELENGTH MAKNAM MINUS
		  MINUSP NCONS NOT NOUUO NULL NUMBERP NUMVAL PLUS PRINC PRINT PRIN1
		  QUOTE READLIST RETURN REVERSE *RSET SUB1 TERPRI TYO ZEROP))))


(MAPCAR (FUNCTION
	 (LAMBDA (&X)
	  (MAPCAR (FUNCTION
		   (LAMBDA (&Y)
		    (PROG2 (PUTPROP &Y (CADDR &X) (QUOTE &RIGHT))
			   (PUTPROP &Y (CADR &X) (QUOTE &LEFT)))))
		  (CAR &X))))
	(QUOTE (((/← SETQ STORE) 1001. 0.)
		((TIMES *TIMES QUOTIENT *QUO) 700. 750.)
		((PLUS *PLUS DIFFERENCE *DIF) 600. 650.)
		((&DEFAULT) 500. 550.)
		((APPEND *APPEND NCONC CONS XCONS CAT) 450. 400.)
		((EQ NEQ EQUAL NEQUAL LESSP *LESS LEQUAL GREATERP *GREAT GEQUAL
			MEMBER MEMQ) 300. 350.)
		((AND) 200. 250.)
		((OR) 100. 150.))))
(DEFPROP INIT1
 (LAMBDA NIL
  (PROG NIL
        (SETQ SCNVAL NIL)
        (*PUTSYM (QUOTE SCNVAL) (GET (QUOTE SCNVAL) (QUOTE VALUE)))
        (LOAD T)))
EXPR)

(DEFPROP INIT2
 (LAMBDA NIL
  (PROG NIL
        (GETSYM SUBR SCAN SCANINIT SCANSET SCANRESET LETTER IGNORE UNTYI SREAD)
        (SCANINIT 45 45 42 42 77)	~ % % (COMMENT) " " (STRING) ? (LITERAL)
	(LETTER 30)			~ _ (UNDERBAR)
        (LETTER 72)			~ : (COLON)
        (LETTER 41)			~ ! (EXCLAMATION POINT)
        (IGNORE 11)			~ TAB
        (IGNORE 12)			~ LINE FEED
        (IGNORE 13)			~ VERTICAL TAB
        (IGNORE 14)			~ FORM FEED
	(IGNORE 15)			~ CARRIAGE RETURN
        (IGNORE 40)			~ BLANK
        (IGNORE 175)			~ ALTMODE
	(SETQ BASE (SETQ IBASE 10.))	~ ALL I/O IS IN DECIMAL TO START WITH
	(REMPROP (QUOTE LAP) (QUOTE MACRO))
	(REMOB RUNFN1 RUNFN2 MINIT SETQS MACROS MACRO1 COMPLR INIT1 INIT2)
	(INITFN (QUOTE MEVAL))))
EXPR)